home *** CD-ROM | disk | FTP | other *** search
/ PsL Monthly 1993 December / PSL Monthly Shareware CD-ROM (December 1993).iso / prgmming / dos / pascal / dgsay.exe / lha / DGSAY.PAS < prev    next >
Pascal/Delphi Source File  |  1989-06-30  |  39KB  |  1,072 lines
  1. {
  2.  ╔═════════════════════════════════════════════════════════════════════════╗
  3.  ║                                                                         ║
  4.  ║        TITLE :      DGSAY.TPU,  Version 8907.01                         ║
  5.  ║      PURPOSE :      Write formatted text to screen.                     ║
  6.  ║       AUTHOR :      David Gerrold, CompuServe ID:  70307,544            ║
  7.  ║  _____________________________________________________________________  ║
  8.  ║                                                                         ║
  9.  ║   Written in Turbo Pascal, Version 5.5,                                 ║
  10.  ║   with routines from Turbo Professional, Version 5.0.                   ║
  11.  ║                                                                         ║
  12.  ║   Turbo Pascal is a product of Borland International.                   ║
  13.  ║   Turbo Professional is a product of TurboPower Software                ║
  14.  ║  _____________________________________________________________________  ║
  15.  ║                                                                         ║
  16.  ║  This is not public domain software.  This is shareware.                ║
  17.  ║  This software is copyright 1989, by David Gerrold.                     ║
  18.  ║                                                                         ║
  19.  ║        The Brass Cannon Corporation                                     ║
  20.  ║        9420 Reseda Blvd., #804                                          ║
  21.  ║        Northridge, CA 91324-2932.                                       ║
  22.  ║                                                                         ║
  23.  ║  If you find this code useful, a donation of $25 is requested --        ║
  24.  ║  not to me, but to the AIDS Project Los Angeles.  Donations may         ║
  25.  ║  be forwarded via the Brass Cannon address.  Thank you.                 ║
  26.  ║                                                                         ║
  27.  ╚═════════════════════════════════════════════════════════════════════════╝
  28.                                                                             }
  29. { ========================================================================= }
  30. {  Compiler Directives :                                                    }
  31. { ========================================================================= }
  32.  
  33. {$R-}    {Range checking off}
  34. {$B+}    {Boolean complete evaluation on}
  35. {$S+}    {Stack checking on}
  36. {$I+}    {I/O checking on}
  37. {$N+,E+} {Simulate numeric coprocessor}
  38. {$M 65520,16384,655360} {Turbo 3 default stack and heap}
  39. {$V-}    {Variable range checking off}
  40.  
  41. { ========================================================================= }
  42. { ========================================================================= }
  43.  
  44. UNIT DGsay;
  45.  
  46. { ========================================================================= }
  47. INTERFACE
  48. { ========================================================================= }
  49.  
  50. USES
  51.   Dos,                                           { TP5.5 unit }
  52.   TpDos,                                         { Turbo Professional unit }
  53.   TpCrt,                                         { Turbo Professional unit }
  54.   TpString,                                      { Turbo Professional unit }
  55.   DgInit,                                        { Dg initialization }
  56.   DgStr;                                         { Dg string object }
  57.  
  58. { ========================================================================= }
  59.  
  60. TYPE
  61. {
  62.   The SayKrnl-Object is the kernel ancestor for Say-Ob (see below);
  63.   None of the methods in SayKrnlOb are intended to be directly called
  64.   by the user;  they are for the internal workings of Say-Ob and its
  65.   descendants.
  66.  
  67.   The variables Indent, Width, JustifyFlag, and NormalAttr,
  68.   should be accessed only by the methods in SayOb.  The variable
  69.   CurrentAttr is for the object's internal bookkeeping and should
  70.   not be tampered with at all.
  71.  
  72.   The Send and SendKrnl methods are virtual, so that a child object can
  73.   be spawned for writing directly to the printer or to a disk file.  The
  74.   next version of this unit will contain such descendant objects.
  75. }
  76.  
  77.   SayKrnlOb = Object (StrOb)
  78.     Indent       : byte;                         { left indent }
  79.     Width        : byte;                         { paragraph width }
  80.     JustifyFlag  : boolean;                      { right justify or not? }
  81.  
  82.     NormalAttr   : byte;                         { normal attribute }
  83.     CurrentAttr  : byte;                         { current attribute }
  84.  
  85.     Constructor Init;
  86.     Function    GetLineBreak  (CheckStr : string) : byte;
  87.     Function    Justify (Jstr : string) : string;
  88.     Function    WordWrap (Limit : byte) : string;
  89.     Procedure   SendKrnl (SendStr : string);  virtual;
  90.     Procedure   Send     (SendStr : string);  virtual;
  91.     Procedure   SayKrnl  (AddStr  : string);
  92.     end;
  93.  
  94. {
  95.   The Say-Object is a replacement for the WriteLn procedure.  Use Say
  96.   and SayLn instead of Write and WriteLn.  The difference is that Say
  97.   will automatically reformat consecutive lines of text.  You can set
  98.   a defined screen width and SayOb will format the text to that width.
  99.   You may also specify a left-indent).
  100.  
  101.   Use consecutive Say ('<text>') commands to output formatted text
  102.   to the screen.  Use a SayLn ('<text>') command to end the paragraph
  103.   and empty the SayOb buffer.  Two consecutive SayLn ('') commands will
  104.   end the paragraph and output a blank line to the screen;
  105.  
  106.   If there is no text in the SayOb buffer, you may use SayLn ('') to
  107.   produce a blank line on screen.
  108. }
  109.   SayOb = Object (SayKrnlOb)
  110.     Constructor Init;
  111.     Procedure   SetIndent (I : byte);
  112.     Procedure   SetWidth (W : byte);
  113.     Procedure   SetAttr (A : byte);              { set NormalAttr }
  114.     Procedure   SetParams (I, W, A : byte;
  115.                            Jflag : boolean);
  116.     Procedure   JustOn;
  117.     Procedure   JustOff;
  118.  
  119.     Function    AttrStr (SetStr : string;
  120.                          A : byte) : string;
  121.  
  122.     Procedure   SayLn   (AddStr  : string);
  123.     Procedure   Say     (AddStr  : string);
  124.     Procedure   SayPara (AddStr  : string);
  125.     Procedure   SayAttr (AddStr  : string;
  126.                             Attr : byte);
  127.   end;
  128.  
  129. VAR
  130.   Simon : SayOb;
  131.  
  132. CONST
  133.   TabStr = '     ';                              { standard para indent }
  134.  
  135. { ========================================================================= }
  136.  
  137. PROCEDURE SayDoc;                                { simultaneous doc/demo }
  138.  
  139. { ========================================================================= }
  140. IMPLEMENTATION
  141. { ========================================================================= }
  142.  
  143. CONSTRUCTOR SayKrnlOb.Init;
  144.  
  145. BEGIN
  146.   S      := '';
  147.   Indent := 5;
  148.   Width  := 70;
  149.   JustifyFlag := true;
  150.  
  151.   NormalAttr  := TextAttr;
  152.   CurrentAttr := TextAttr;
  153. END;
  154.  
  155. { ========================================================================= }
  156.  
  157. FUNCTION SayKrnlOb.GetLineBreak (CheckStr : string) : byte;
  158. {
  159.   Locates the place to break the string for Wordwrap, allowing for
  160.   imbedded control characters.  Also used by the Justify function to
  161.   check the length of the string to be justified.
  162. }
  163. VAR
  164.   Len  : byte absolute CheckStr;
  165.   Loop : byte;
  166.   Ctr  : byte;
  167.  
  168. BEGIN
  169.   Ctr := Width;                                  { break here }
  170.   Loop := 0;
  171.   Repeat
  172.     inc (Loop);                                  { count through str }
  173.     if CheckStr [Loop] = #0 then begin           { if attribute change }
  174.       inc (Ctr, 2);                              { count it }
  175.       inc (Loop);                                { step past it }
  176.       end;
  177.   Until
  178.     (Loop >= Ctr)
  179.       or
  180.     (Loop >= Len);                                { until end of str }
  181.  
  182.   GetLineBreak := Ctr;                            { return count }
  183. END;
  184.  
  185. { ========================================================================= }
  186.  
  187. FUNCTION SayKrnlOb.Justify (Jstr : string) : string;
  188. {
  189.   Returns a string internally padded with spaces so that length = limit.
  190. }
  191. VAR
  192.   Jlen      : byte absolute Jstr;
  193.  
  194.   Loop      : byte;
  195.   LineB